{- This file is part of funbot.
 -
 - Written in 2015, 2016, 2017 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Control.Concurrent.Chan (newChan)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runLoggingT, LogLevel (LevelInfo))
import Data.Default.Class (def)
import Data.Monoid ((<>))
import Data.Settings.Section (empty)
import Data.Yaml.Config (loadYamlSettings, useEnv)
import Database.Persist.Postgresql
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.IRC.Fun.Bot (runBot)
import Network.IRC.Fun.Bot.EventMatch
import Network.IRC.Fun.Bot.Types (Behavior (..), EventMatchSpace (..))
import System.Log.FastLogger
import Web.Feed.Collect (newCommandQueue)

import qualified Data.HashMap.Lazy as M (empty)

import FunBot.Commands
import FunBot.ExtHandlers (handler)
import FunBot.Migration
import FunBot.Settings
import FunBot.Settings.Persist
import FunBot.Settings.Sections
import FunBot.Sources
import FunBot.Types
import FunBot.UserOptions
import FunBot.Util (cmds)

import qualified FunBot.Config as C
import qualified FunBot.IrcHandlers as H

-- | Bot environment content
env saveS saveUO cq lq pool mgr = BotEnv
    { webHookSourcePort = C.webListenerPort
    , saveSettings      = saveS
    , saveUserOpts      = saveUO
    , feedErrorLogFile  = C.feedErrorLogFile
    , feedCmdQueue      = cq
    , loopbackQueue     = lq
    , dbConnPool        = pool
    , httpManager       = mgr
    }

-- | Initial content of the bot state
initialState sets userOpts = BotState
    { bsSettings    = sets
    , bsSTree       = empty
    , bsUserOptions = userOpts
    , bsLastMsgTime = M.empty
    , bsPuppet      = M.empty
    , bsPrivPuppet  = Nothing
    , bsMemoReady   = M.empty
    }

-- | Event detector specification
matchers =
    [ matchPrefixedCommand
        MatchInChannel
        True
    , matchPrefixedCommandFromNames
        MatchInPrivate
        True
        (Right commandSet)
        privCmds
    , matchRefCommandFromSet
        MatchInChannel
        modPleasePrefix'
    , matchRefCommandFromNames
        MatchInPrivate
        modPleasePrefix'
        True
        privCmds
    , matchRef
        MatchInBoth
    , defaultMatch
    ]
    where
    privCmds = cmds
        [ "help", "version", "info", "echo", "tell", "ask", "get", "show-opts"
        , "enable-history" , "disable-history", "set-history-lines"
        , "erase-opts", "show-history" , "where", "lwhere", "gwhere"
        ]


-- | Bot behavior definition
behavior :: Behavior BotEnv BotState
behavior = def
    { handleJoin           = H.handleJoin
    , handlePart           = H.handlePart
    , handleQuit           = H.handleQuit
    , handleMsg            = H.handleMsg
    , handleAction         = H.handleAction
    , handleBotMsg         = H.handleBotMsg
    , commandSets          = [commandSet]
    , handlePersonalMsg    = H.handlePersonalMsg
    , handlePersonalAction = H.handlePersonalAction
    , handleNickChange     = H.handleNickChange
    , handleNames          = H.handleNames
    }

-- | Additional events sources
mkSources state = do
    lgset <- newFileLoggerSet defaultBufSize "state/web-access.log"
    return
        [ webListenerSource WebListenerSettings
            { wlsRqLogDev   = False
            , wlsRqLogColor = False
            , wlsRqLogger   = lgset
            , wlsErrLogFile = C.webErrorLogFile
            }
        , feedWatcherSource C.feedErrorLogFile state
        , loopbackSource
        ]

logFunc :: LoggerSet -> LogFunc
logFunc set _loc src level msg = do
    let line =
            "[" <> toLogStr (show level) <> "#" <> toLogStr src <> "] " <> msg
    when (level >= LevelInfo) $ pushLogStrLn set line

makeDbConnPool :: IO ConnectionPool
makeDbConnPool = do
    logger <- newStdoutLoggerSet defaultBufSize
    let logfunc = logFunc logger
    dbconf <- loadYamlSettings ["config/db.yaml"] [] useEnv
    flip runLoggingT logfunc $ do
        pool <- createPostgresqlPool (pgConnStr dbconf) (pgPoolSize dbconf)
        runSqlPool migrateDB pool
        return pool

main :: IO ()
main = do
    liftIO $ putStrLn "Loading bot settings"
    sets <- loadBotSettings
    uos <- loadUserOptions
    saveS <- mkSaveBotSettings
    saveUO <- mkSaveUserOptions
    cq <- newCommandQueue
    lq <- newChan
    pool <- makeDbConnPool
    mgr <- newManager tlsManagerSettings
    let state = initialState sets uos
    sources <- mkSources state
    runBot
        C.configuration
        matchers
        behavior
        sources
        handler
        (env saveS saveUO cq lq pool mgr)
        state
        (migrateFromJSON >> initTree)
